Programmes de géodésie
Pour visualiser les sources des programmes
vous devez télécharger le fichier de police ti dans
le dossier : C:\WINDOWS\FONTS\
Pour ne rien oublier voici le diagramme du programme
Télécharger les sources aux format 8XP
Voir les consignes au sujet des
Programmes au format PDF
Programme A01TOOP
EffEcr
Lbl 99
Menu(" TOPOGRAPHIE ","M,L vers X,Y",1,"X,Y vers M,L",2,"ChanG d'elipso",5,"M,L vers UTM",17,"Lambert 93",4,"Temps Astro",6,"Stop",7
Lbl 1
prgmLBTXY
Goto 99
Lbl 2
prgmLBTML
Goto 99
Lbl 4
EffEcr
prgmLBT93
Goto 99
Lbl 5
prgmCHELLIP
Goto 99
Lbl 17
prgmXYUTM
Goto 99
Lbl 7
Stop
Lbl 6
prgmTIME
Goto 99
Programme CHELLIP
EffEcr
Disp "Changement D'"
Radian
Disp "ellipsoide"
Pause
EffEcr
Disp "Elipsoid depart"
Disp ""
Disp "Entrer a"
Input A
Disp "Entrer b"
Input B
EffEcr
Disp ""
Disp "Longitude M"
Input M
Disp "Latitude L"
Input L
Disp "Hauteur ellipso"
Input H
M*(
/200)
M
L*(/200)L
(A^2-B^2)/A^2E
A/
(1-E*(sin(L))^2)V
(V+H)*cos(L)*cos(M)X
(V+H)*cos(L)*sin(M)Y
(V*(1-E)+H)*sin(L)Z
EffEcr
Disp ""
Disp "Grande Normale"
Disp ""
Disp "",V
Pause
EffEcr
Disp "Coordon Cartes"
Disp " X =",X
Disp " Y =",Y
Disp " Z =",Z
Pause
EffEcr
Disp ""
Disp ""
Disp ""
Disp "Ecarts entre Cen"
Pause
EffEcr
Disp "T X"
Input C
Disp "T X"
Input P
Disp "T X"
Input R
EffEcr
Disp ""
Disp "Rotation ellipso"
Input I
I*(/200)I
X*cos(I)+Y*sin(I)+CS
X*sin(I)+Y*cos(I)+PT
Z+RO
SX
TY
OZ
EffEcr
Disp "Nouvaux X,Y,Z"
Disp " X =",X
Disp " Y =",Y
Disp " Z =",Z
Pause
EffEcr
Disp "Elipsoid arrive"
Disp ""
Disp "Entrer a"
Input A
Disp "Entrer b"
Input B
(X^2+Y^2)R
(A^2-B^2)/A^2E
50S
S*(/200)S
A/((1-E*sin(S))^2)N
Lbl 5
Arctan((Z+N*E*sin(S))/R)F
If abs(S-F)>10^8
Then
FS
Goto 5
Else
Goto 10
Lbl 10
EffEcr
R/cos(S)-NH
Arctan(Y/X)L
L*(200/)L
S*(200/)S
Disp "In the new Systm"
Disp "Longitude gon",L
Disp "Latitude gon",S
Disp "Altitude geo M",H
Pause
EffEcr
Disp ""
Disp "Grande Normale"
Disp ""
Disp "",N
Pause
EffEcr
Return
Programme LBT93
Lbl 99
Degr–
700000A
6600000B
0.0818191911E
0.0818191911Z
11754255.426C
0.72560776503208D
6055612.0502F
6378137G
Menu(" Lambert 93 ","M,L -> X,Y",1,"X,Y -> M,L",2,"Module lin",3,"Charge param",99,"Custom",75,"Sortie",4
Lbl 4
Return
Lbl 1
EffEcr
Disp "Longitude ?"
Input M
Disp "Latitude ?"
LW
Input L
ln(tan(L/2+45))+(E/2)*ln((1-E*sin(L))/(1+E*sin(L)))L
A+C*
^(D*L)*sin(D*(M-3))X
(B+F)-C*^(D*L)*cos(D*(M-3))Y
EffEcr
Disp "X : ",X
Disp "Y : ",Y
Pause
Goto 99
Lbl 2
EffEcr
Disp "X ?"
Input X
Disp "Y ?"
Input Y
EffEcr
Disp "Calculs . . ."
Disp ". . . en cours"
Arctan((X-A)/((B+F)-Y))/D+3M
(1/D)*ln((((X-A)+((B+F)-Y))/C))L
2*Arctan(^(L))-90P
46.5F
F-10R
F+10S
Lbl 10
(R+S)/2T
ln(tan(T/2+45))+(E/2)*ln((1-E*sin(T))/(1+E*sin(T)))-LQ
If Q<0
Then
TR
Else
TS
End
If abs(R-S)>1û12
Then
Goto 10
End
EffEcr
Disp "Resultats deg"
Disp ""
Disp "Longitude :",M
Disp "Latitude :",T
Pause
EffEcr
Disp "Resultats deg"
Disp ""
Disp "Longitude :",MåDMS
Disp "Latitude :",TåDMS
Pause
Goto 99
Lbl 3
EffEcr
Disp "Latitude"
Input P
ln(tan(P/2+45)*((1-E*sin(P))/(1+E*sin(P)))^(E/2))L
11754255.426C
0.7256077650N
0.8522472765M
C*^(N*M)R
(1-Z*(sin(P)))H
^(N*(L-M))I
(N*R)/(G*cos(P))J
H*I*JM
Disp "Module =",M
Disp "Module ppm =",(1-M)*1û6
Pause
Goto 99
Lbl 75
EffEcr
Disp "Phi 1"
Input I
Disp "Phi 2"
Input J
Disp "Phi 0"
Input K
Disp "A"
Input A
Disp "E"
Input Z
Z^0.5E
A/((1-Z*sin(I)))V
A/((1-Z*sin(J)))W
ln(tan(I/2+45)*((1-E*sin(I))/(1+E*sin(I)))^(E/2))X
ln(tan(J/2+45)*((1-E*sin(J))/(1+E*sin(J)))^(E/2))Y
ln(tan(K/2+45)*((1-E*sin(K))/(1+E*sin(K)))^(E/2))K
ln((W*cos(J))/(V*cos(I)))/(X-Y)N
V*cos(I)*^(N*X)/NC
C*^(N*K)R
EffEcr
Disp "n =",N
Disp "C =",C
Disp "R0 =",R
EffEcr
Disp "Phi C =",Arcsin(N)
Disp "Phi C =",Arcsin(N)åDMS
Pause
Goto 99
Programme LBTML
0.08248325676G
EffEcr
Disp "Lambert XY LM"
Disp "X Lambert"
Input X
Disp "Y Lambert"
Input Y
prgmLBTZO
EffEcr
Disp ""
Disp ""
Disp ""
Disp "Calculs en cours"
C*(/200)C
X-AX
Y-BY
Arctan(X/(D-Y))F
(D-Y)/cos(F)H
F/sin(C)M
ln(tan((/4)+C/2)*(((1-G*sin(C))/(1+G*sin(C)))^(G/2)))O
O-((ln(H/D))/sin(C))P
Y/10^5E
E*(/200)E
C+EE
E-0.007853982R
E+0.015707963S
Lbl 22
(R+S)/2T
ln(tan(/4+T/2)*((1-G*sin(T))/(1+G*sin(T)))^(G/2))-PQ
If Q<0
Then
TR
End
If Q>0
Then
TS
End
abs(R-S)U
If U>1*10^9
Goto 22
If U<1*10^9
Goto 33
Lbl 33
M*(200/)M
T*(200/)L
If B>500000
Then
M+10/3M
End
EffEcr
Disp "Resultats"
Disp ""
Disp "Longitude =",M
Disp "Latitude =",L
Pause
EffEcr
Disp "Conver M",F*(200/)
Disp "Rayon R'",H
Pause
Return
Programme LBTXY
EffEcr
Disp "Longitude M"
0.08248325676Z
Input M
Disp "Latitude L"
Input L
prgmLBTZO
M*(/200)M
L*(/200)L
C*(/200)C
M*sin(C)E
tan((/4)+L/2)N
1-Z*sin(L)O
1+Z*sin(L)M
Z/2P
ln(N*((O/M)^P))F
tan((/4)+C/2)N
1-Z*sin(C)O
1+Z*sin(C)M
Z/2P
ln(N*((O/M)^P))G
(F-G)*sin(C)T
D*^(T)H
A+H*sin(E)X
B+(D-H*cos(E))Y
ln(tan(L/2+/4))+(Z/2)*ln((1-Z*sin(L))/(1+Z*sin(L)))A
ln(tan(C/2+/4))+(Z/2)*ln((1-Z*sin(C))/(1+Z*sin(C)))B
D*sin(C)*(((1-Z*sin(L)))*^((A-B)*sin(C)))/(6378249.2*cos(L))U
EffEcr
Disp "ResuLtats"
Disp ""
Disp "X Lbt",X
Disp "Y Lbt",Y
Pause
EffEcr
Disp "Conver M",E*(200/)
Disp "Rayon R'",H
Disp "Module Ã",U
Pause
Return
Programme LBTZO
Radian
EffEcr
Lbl 1
Disp "Zone Lbt Cust=99"
Input C
If C=1
Goto 11
If C=2
Goto 22
If C=3
Goto 33
If C=4
Goto 44
If C=99
Goto 99
EffEcr
Disp "Voyons Geometre"
Disp "une zone Lambert",C
Disp "Laise moi rire !"
Disp ""
Goto 1
End
Lbl 11
600000A
200000B
55C
5457616.68D
Goto 83
Lbl 22
600000A
200000B
52C
5999695.77D
Goto 83
Lbl 33
600000A
200000B
49C
6591905.08D
Goto 83
Lbl 44
234.36A
185861.67B
46.85C
7053300.18D
Goto 83
Lbl 83
EffEcr
Return
Lbl 93
EffEcr
Disp "Utiliser le"
Disp "Programme lbt93"
Goto 1
EffEcr
Return
Lbl 99
Disp "X0"
Input A
Disp "Y0"
Input B
Disp "PHI0"
Input C
Disp "E"
Input Z
Disp "RAYON CONE"
Input D
EffEcr
Return
Programme TIME
EffEcr
Disp "Tps decimaux !"
Pause
Lbl 99
Menu(" Programme Time ","Heure siderale",1,"Equation temps",2,"Heure civil",3,"Temps Universl",4,"Heure legale",5,"Quitter",6
Lbl 1
EffEcr
Disp "Asention droite"
Input C
Disp "Angle Horaire A"
Input D
EffEcr
Disp "H side loc ="
Disp ""
Disp C+D
Pause
Disp "HSGreenwich"
Input C
Disp "Longitude"
Input D
Disp "H side loc ="
Disp ""
Disp C+D
Pause
EffEcr
Disp "Longitude"
Input A
Disp "TU"
Input B
Disp "HSG(OhUT)"
Input C
Disp "H side loc ="
Disp "",C+B*(366.2422/365.2422)+A
Pause
Goto 99
Lbl 2
EffEcr
Disp "Equation Temps"
Input A
Disp "Temps moyen"
Input B
Disp "Angle HorairV",B-A
Pause
Goto 99
Lbl 3
EffEcr
Disp "Angle Sol moy"
Input A
Disp "Temps Universl"
Input B
Disp "Longitude"
Input C
EffEcr
Disp "HCL =",A+12
Disp "HCL =",B+C
Pause
Goto 99
Lbl 4
EffEcr
Disp "Temps siderale"
Input A
Disp "TU =",A*(365.2422/366.2422)
Pause
Goto 99
Lbl 5
Disp "TU ?"
Input A
Disp "Numero fuseau"
Input B
Disp "Decalage"
Input C
EffEcr
Disp "Heure locale",A+B+C
Pause
Goto 99
Lbl 6
Return
Programme XYUTM
EffEcr
Disp ""
Disp "Convertir Les"
Disp "Longit ? Latitud"
Disp "Vers X et Y UTM"
Pause
EffEcr
Disp "Longitude en "
Input M
EffEcr
Disp "Latidude en ?"
Input L
EffEcr
Disp ""
Disp ""
Disp ""
Disp " CALCUL EN COUR"
(6*partEnt(M/6)+3)*(/180)K
M*(/180)M
L*(/180)L
6378388A
6356911.9461B
297C
0.00672267002^0.5D
0.9996F
(D^2/(1-D^2))^0.5E
1-D^2/4-3*D^4/64-5*D^6/256G
3*D^2/8-3*D^4/32-45*D^6/1024H
15*D^4/256+45D^6/1024I
35D^6/3072J
M-KN
A*(G*L+H*sin(2*L)+I*sin(4L)+J*sin(6*L))O
A/((1-D^2*(sin(L))^2)^0.5)P
(E^2*(cos(L))^2)^0.5Q
(tan(L))^2R
cos(L)S
0.5*cos(L)*sin(L)T
(cos(L))^3*(1-R^2+Q^2)/6U
(1/24)*(cos(L))^3*sin(L)*(5-R^2+9*Q^2+4*Q^4)V
(1/120)*(cos(L))^5*(5-18*R^2+R^4+14*Q^2-58*R^2*Q^2-64*Q^4*R^(2+13*Q^4))W
(1/720)*(cos(L))^5*sin(L)*(61-58*R^2+R^4+270*Q^2+445*Q^4-330*R^2*Q^2-680*Q^4*R^2)Z
P*(S*N+U*N^3+W*N^5)X
O+P*(T*N^2+V*N^4+Z*N^6)Y
F*X+500000X
F*YY
M*(180/)M
partEnt(M/6)+31F
EffEcr
Disp "X utm",X
Disp "Y utm",Y
Disp ""
Disp "Fuseau utm",F
Pause
Programme LATISO
Radian
Disp "Latitude gr"
Input A
0.0818191910373110E
Disp "e SI OK TAPE E",E
Input E
A*/200A
tan(A/2+/4)D
((1-E*sin(A))/(1+E*sin(A)))^(E/2)F
ln(D*F)L
Disp "LAT ISO",L